home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp3.arc / RECEIVEX.PAS < prev    next >
Pascal/Delphi Source File  |  1985-10-03  |  51KB  |  1,384 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Receive_Xmodem_File --- Download file using XMODEM         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Receive_Xmodem_File( Use_CRC : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Receive_Xmodem_File                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Downloads file from remote host using XMODEM         *)
  12. (*                 protocol.                                            *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Receive_Xmodem_File( Use_CRC );                               *)
  17. (*                                                                      *)
  18. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  19. (*                       of XMODEM; FALSE to use Checksum version.      *)
  20. (*                                                                      *)
  21. (*     Remarks:                                                         *)
  22. (*                                                                      *)
  23. (*        The transmission parameters are automatically set to:         *)
  24. (*                                                                      *)
  25. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  26. (*                                                                      *)
  27. (*        and then they are automatically restored to the previous      *)
  28. (*        values when the transfer is complete.                         *)
  29. (*                                                                      *)
  30. (*        This code actually controls file reception using any of the   *)
  31. (*        Xmodem-based protocols:  Xmodem, Modem7, Telink, and Ymodem.  *)
  32. (*                                                                      *)
  33. (*     Calls:   KeyPressed                                              *)
  34. (*              Async_Send                                              *)
  35. (*              Async_Receive                                           *)
  36. (*              Async_Receive_With_Timeout                              *)
  37. (*              Async_Purge_Buffer                                      *)
  38. (*              Compute_Crc                                             *)
  39. (*              Update_Xmodem_Receive_Display                           *)
  40. (*              Display_Receive_Error                                   *)
  41. (*              Receive_Xmodem_Sector                                   *)
  42. (*              Receive_Telink_Header                                   *)
  43. (*              Receive_Ymodem_Header                                   *)
  44. (*              Wait_For_SOH                                            *)
  45. (*              Set_File_Date_And_Time                                  *)
  46. (*              Draw_Menu_Frame                                         *)
  47. (*              Open_Receiving_File                                     *)
  48. (*              Write_File_Handle                                       *)
  49. (*              Close_File_Handle                                       *)
  50. (*                                                                      *)
  51. (*----------------------------------------------------------------------*)
  52.  
  53. CONST
  54.    Max_Errors       = 20           (* Maximum errors before aborting    *)
  55.                                    (* reception                         *);
  56. VAR
  57.    Sector_Count  : INTEGER         (* Sector count -- no wrap at 255    *);
  58.    Sector_Comp   : BYTE            (* Complement of current sector #    *);
  59.    Sector_Prev   : BYTE            (* Previous sector number            *);
  60.    I             : INTEGER         (* Loop index                        *);
  61.    Error_Count   : INTEGER         (* # of errors encountered           *);
  62.    Ch            : INTEGER         (* Character read from COM port      *);
  63.    Error_Flag    : BOOLEAN         (* IF an error is found              *);
  64.    Initial_Ch    : INTEGER         (* Initial character                 *);
  65.    Sector_Length : INTEGER         (* Sector Length                     *);
  66.    Sector_Prev1  : BYTE            (* Previous sector + 1               *);
  67.    BlockL_Errors : INTEGER         (* Counts block length errors        *);
  68.    SOH_Errors    : INTEGER         (* Counts SOH errors                 *);
  69.    BlockN_Errors : INTEGER         (* Counts block number errors        *);
  70.    Comple_Errors : INTEGER         (* Counts complement errors          *);
  71.    Timeout_Errors: INTEGER         (* Counts timeout errors             *);
  72.    Resend_Errors : INTEGER         (* Counts resend block errors        *);
  73.    CRC_Errors    : INTEGER         (* Counts checksum/crc errors        *);
  74.    Effective_Rate: REAL            (* Effective baud rate of transfer   *);
  75.    CRC_Tries     : INTEGER         (* Initial CRC tries                 *);
  76.    SOH_Time      : INTEGER         (* Seconds to wait for SOH           *);
  77.    RFile_Size    : REAL            (* Actual file size                  *);
  78.    RFile_Date    : REAL            (* File date/time                    *);
  79.    File_Date     : INTEGER         (* MS DOS encoded file date          *);
  80.    File_Time     : INTEGER         (* MS DOS encoded file time          *);
  81.    RFile_Name    : AnyStr          (* Received file name, Ymodem        *);
  82.    Truncate_File : BOOLEAN         (* TRUE to trunc. file to exact size *);
  83.    RFile_Open    : BOOLEAN         (* TRUE if receiving file opened     *);
  84.    XFile_Byte    : FILE OF BYTE    (* For truncating received file      *);
  85.    OK_Transfer   : BOOLEAN         (* If transfer OK                    *);
  86.    Block_Zero    : BOOLEAN         (* If block 0 encountered            *);
  87.  
  88.    RFile_Size_2  : REAL            (* File size from totalling sectors  *);
  89.    TName         : ShortStr        (* Transfer type                     *);
  90.  
  91.    Display_Time  : BOOLEAN         (* Display time remaining for trans. *);
  92.    Time_To_Send  : REAL            (* Time in seconds to transfer file  *);
  93.    Start_Time    : REAL            (* Starting time of transfer         *);
  94.    End_Time      : REAL            (* Ending time of transfer           *);
  95.    Time_Per_Block: REAL            (* Time for one block                *);
  96.    Blocks_To_Get : REAL            (* Number of blocks                  *);
  97.    Write_Count   : INTEGER         (* Number of bytes to write          *);
  98.    Err           : INTEGER         (* Error flag for handle I/O         *);
  99.  
  100.                                    (* Write buffer pointer              *)
  101.    Write_Buffer  : File_Handle_Buffer_Ptr;
  102.    Buffer_Pos    : INTEGER         (* Current buffer position           *);
  103.    Buffer_Length : INTEGER         (* Buffer length                     *);
  104.    Use_CRC_2     : BOOLEAN         (* TRUE to use CRC method            *);
  105.    Menu_Title    : AnyStr          (* Menu title                        *);
  106.    Alt_R_Pressed : BOOLEAN         (* TRUE if Alt-R cancelled download  *);
  107.    Long_Buffer   : BOOLEAN         (* TRUE if separate buffer used      *);
  108.  
  109. (*----------------------------------------------------------------------*)
  110. (*           Open_Receiving_File --- open file to receive download      *)
  111. (*----------------------------------------------------------------------*)
  112.  
  113. PROCEDURE Open_Receiving_File;
  114.  
  115. VAR
  116.    Err: INTEGER;
  117.  
  118. BEGIN (* Open_Receiving_File *)
  119.                                    (* Check if file name given yet. *)
  120.                                    (* If not, prompt for it.        *)
  121.  
  122.    IF FileName = '' THEN
  123.       BEGIN
  124.  
  125.          Window( 1, 1, 80, 25 );
  126.          GoToXY( 1 , 25 );
  127.          WRITE('Enter file name to receive download: ');
  128.          READLN( FileName );
  129.  
  130.       END;
  131.                                    (* Open reception file *)
  132.    IF ( NOT RFile_Open ) THEN
  133.       BEGIN
  134.  
  135.          Err := Create_File_Handle( FileName, Attribute_None, XFile_Handle );
  136.  
  137.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  138.             BEGIN
  139.  
  140.                GoToXY( 25 , 10 );
  141.                WRITE('Cannot open reception file, download cancelled.');
  142.                ClrEol;
  143.  
  144.                DELAY( One_Second_Delay );
  145.  
  146.                Stop_Receive := TRUE;
  147.  
  148.             END
  149.          ELSE
  150.             RFile_Open := TRUE;
  151.  
  152.       END;
  153.  
  154.    IF Rfile_Open THEN
  155.       Writelne('Receiving file ' + FileName, FALSE );
  156.  
  157. END   (* Open_Receiving_File *);
  158.  
  159. (*----------------------------------------------------------------------*)
  160. (*   Initialize_Receive_Display --- Set up display of Xmodem reception  *)
  161. (*----------------------------------------------------------------------*)
  162.  
  163. PROCEDURE Initialize_Receive_Display;
  164.  
  165. BEGIN (* Initialize_Receive_Display *)
  166.  
  167.    GoToXY( 1 , 1 );
  168.  
  169.    WRITE(' Blocks received      :');
  170.    ClrEol;
  171.  
  172.    GoToXY( 1 , 2 );
  173.    WRITE(' Block length errors  :');
  174.    ClrEol;
  175.  
  176.    GoToXY( 1 , 3 );
  177.    WRITE(' SOH errors           :');
  178.    ClrEol;
  179.  
  180.    GoToXY( 1 , 4 );
  181.    WRITE(' Block number errors  :');
  182.    ClrEol;
  183.  
  184.    GoToXY( 1 , 5 );
  185.    WRITE(' Complement errors    :');
  186.    ClrEol;
  187.  
  188.    GoToXY( 1 , 6 );
  189.    WRITE(' Timeout errors       :');
  190.    ClrEol;
  191.  
  192.    GoToXY( 1 , 7 );
  193.    WRITE(' Resend block errors  :');
  194.    ClrEol;
  195.  
  196.    GoToXY( 1 , 8 );
  197.  
  198.    IF ( NOT Use_Crc ) THEN
  199.       WRITE(' Checksum errors      :')
  200.    ELSE
  201.       WRITE(' CRC errors           :');
  202.  
  203.    ClrEol;
  204.  
  205.    GoToXY( 1 , 9 );
  206.  
  207.    IF Display_Time THEN
  208.       WRITE(' Approx. time left    :')
  209.    ELSE
  210.       WRITE(' ');
  211.  
  212.    ClrEol;
  213.  
  214.    GoToXY( 1 , 10 );
  215.    WRITE  (' Last status message  :');
  216.    ClrEol;
  217.  
  218. END   (* Initialize_Receive_Display *);
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (* Update_Xmodem_Receive_Display --- Update display of Xmodem reception *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. PROCEDURE  Update_Xmodem_Receive_Display;
  225.  
  226. BEGIN (* Update_Xmodem_Receive_Display *)
  227.  
  228.    GoToXY( 25 , 1 );
  229.    WRITE( Sector_Count );
  230.    GoToXY( 25 , 2 );
  231.    WRITE(BlockL_Errors);
  232.    GoToXY( 25 , 3 );
  233.    WRITE(SOH_Errors);
  234.    GoToXY( 25 , 4 );
  235.    WRITE(BlockN_Errors);
  236.    GoToXY( 25 , 5 );
  237.    WRITE(Comple_Errors);
  238.    GoToXY( 25 , 6 );
  239.    WRITE(Timeout_Errors);
  240.    GoToXY( 25 , 7 );
  241.    WRITE(Resend_Errors);
  242.    GoToXY( 25 , 8 );
  243.    WRITE(CRC_Errors);
  244.  
  245.    IF Display_Time THEN
  246.       BEGIN
  247.          GoToXY( 25 , 9 );
  248.          WRITE( TimeString( Time_To_Send ) );
  249.       END;
  250.  
  251. END   (* Update_Xmodem_Receive_Display *);
  252.  
  253. (*----------------------------------------------------------------------*)
  254. (*     Display_Receive_Error --- Display XMODEM reception error         *)
  255. (*----------------------------------------------------------------------*)
  256.  
  257. PROCEDURE  Display_Receive_Error( Err_Text: AnyStr );
  258.  
  259. BEGIN (* Display_Receive_Error *)
  260.  
  261.    GoToXY( 25 , 10 );
  262.    WRITE(Err_Text,' in block ',Sector_Count);
  263.    ClrEol;
  264.    Error_Flag := TRUE;
  265.  
  266. END   (* Display_Receive_Error *);
  267.  
  268. (*----------------------------------------------------------------------*)
  269. (*           Receive_Xmodem_Sector --- Get sector using XMODEM          *)
  270. (*----------------------------------------------------------------------*)
  271.  
  272. FUNCTION Receive_Xmodem_Sector( Use_CRC : BOOLEAN ) : BOOLEAN;
  273.  
  274. (*----------------------------------------------------------------------*)
  275. (*                                                                      *)
  276. (*     Function:   Receive_Xmodem_Sector                                *)
  277. (*                                                                      *)
  278. (*     Purpose:    Gets one sector using XMODEM protocol.               *)
  279. (*                                                                      *)
  280. (*     Calling Sequence:                                                *)
  281. (*                                                                      *)
  282. (*        OK_Get := Receive_Xmodem_Sector( Use_CRC : BOOLEAN )          *)
  283. (*                                       : BOOLEAN;                     *)
  284. (*                                                                      *)
  285. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  286. (*                       of XMODEM; FALSE to use Checksum version.      *)
  287. (*           OK_Get  --- TRUE if sector received correctly              *)
  288. (*                                                                      *)
  289. (*     Calls:   Async_Send                                              *)
  290. (*              Async_Receive_With_Timeout                              *)
  291. (*              Update_Crc                                              *)
  292. (*              Display_Receive_Error                                   *)
  293. (*                                                                      *)
  294. (*----------------------------------------------------------------------*)
  295.  
  296. VAR
  297.    CRC      : INTEGER;
  298.    Checksum : INTEGER;
  299.    I        : INTEGER;
  300.  
  301. BEGIN (* Receive_Xmodem_Sector *)
  302.  
  303.                                    (* Pick up sector data, calculate *)
  304.                                    (* checksum or CRC                *)
  305.    Receive_Xmodem_Sector := FALSE;
  306.  
  307.    Checksum    := 0;
  308.    CRC         := 0;
  309.                                    (* Sector length is 128 for usual *)
  310.                                    (* Xmodem or Telink; is 1024 for  *)
  311.                                    (* Ymodem.                        *)
  312.    FOR I := 1 TO Sector_Length DO
  313.       BEGIN
  314.                                    (* Get next character *)
  315.  
  316.          Async_Receive_With_Timeout( One_Second , Ch );
  317.  
  318.                                    (* Check for timeout  *)
  319.          IF Ch = TimeOut THEN
  320.             BEGIN
  321.                Display_Receive_Error('Block length error');
  322.                BlockL_Errors := BlockL_Errors + 1;
  323.             END;
  324.  
  325.                                    (* Store received character *)
  326.          Sector_Data[I] := Ch;
  327.                                    (* Update CRC or Checksum   *)
  328.          IF Use_Crc THEN
  329.             CRC := Update_CRC( CRC, Ch )
  330.          ELSE
  331.             Checksum := ( Checksum + Ch ) AND 255;
  332.  
  333.       END;
  334.  
  335.                                    (* Now get trailing CRC or  *)
  336.                                    (* checksum value.          *)
  337.    IF Use_Crc THEN
  338.       BEGIN   (* Receive CRC *)
  339.                                    (* Get first byte of CRC    *)
  340.  
  341.          Async_Receive_With_Timeout( One_Second , Ch );
  342.  
  343.                                    (* Check for timeout        *)
  344.          IF Ch <> Timeout THEN
  345.             BEGIN  (* Byte CRC OK *)
  346.  
  347.                                    (* Update CRC               *)
  348.  
  349.                CRC  := Update_CRC( CRC , Ch );
  350.  
  351.                                    (* Get second byte of CRC   *)
  352.  
  353.                Async_Receive_With_Timeout( One_Second , Ch );
  354.  
  355.                                    (* If not timeout, update CRC *)
  356.                                    (* and check if it is zero.   *)
  357.                                    (* Zero CRC means OK sector.  *)
  358.                IF Ch <> Timeout THEN
  359.                   BEGIN  (* Byte 2 CRC OK *)
  360.  
  361.                      CRC                   := Update_CRC( CRC , Ch );
  362.                      Receive_Xmodem_Sector := ( CRC = 0 );
  363.  
  364.                   END    (* Byte 2 CRC OK *)
  365.                ELSE
  366.                   BEGIN  (* Byte 2 CRC Timeout *)
  367.  
  368.                      Display_Receive_Error('Block length error');
  369.                      BlockL_Errors := BlockL_Errors + 1;
  370.  
  371.                   END    (* Byte 2 CRC Timeout *)
  372.  
  373.             END   (* Byte 1 CRC OK *)
  374.  
  375.          ELSE
  376.             BEGIN (* Byte 1 CRC Timeout *)
  377.  
  378.                Display_Receive_Error('Block length error');
  379.                BlockL_Errors := BlockL_Errors + 1;
  380.  
  381.             END   (* Byte 1 CRC Timeout *);
  382.  
  383.       END     (* Compute CRC *)
  384.  
  385.    ELSE
  386.       BEGIN   (* Receive Checksum *)
  387.  
  388.                                    (* Read sector checksum, see if it matches *)
  389.                                    (* what we computed from sector read.      *)
  390.  
  391.          Async_Receive_With_Timeout( One_Second , Ch );
  392.  
  393.          Receive_Xmodem_Sector := ( Checksum = Ch );
  394.  
  395.       END    (* Receive Checksum *);
  396.  
  397. END   (* Receive_Xmodem_Sector *);
  398.  
  399. (*----------------------------------------------------------------------*)
  400. (*           Receive_Telink_Header --- Get Telink block 0 header        *)
  401. (*----------------------------------------------------------------------*)
  402.  
  403. PROCEDURE Receive_Telink_Header;
  404.  
  405. (*----------------------------------------------------------------------*)
  406. (*                                                                      *)
  407. (*     Procedure:  Receive_Telink_Header                                *)
  408. (*                                                                      *)
  409. (*     Purpose:    Gets Telink header block 0 (filename+size+date)      *)
  410. (*                                                                      *)
  411. (*     Calling Sequence:                                                *)
  412. (*                                                                      *)
  413. (*        Receive_Telink_Header;                                        *)
  414. (*                                                                      *)
  415. (*     Calls:                                                           *)
  416. (*                                                                      *)
  417. (*        Trim                                                          *)
  418. (*        Dir_Convert_Time                                              *)
  419. (*        Dir_Convert_Date                                              *)
  420. (*        Draw_Menu_Frame                                               *)
  421. (*                                                                      *)
  422. (*----------------------------------------------------------------------*)
  423.  
  424. VAR
  425.    I      : INTEGER;
  426.    CDate  : STRING[8];
  427.    CTime  : STRING[8];
  428.  
  429. BEGIN  (* Receive_Telink_Header *)
  430.  
  431.    RFile_Size := 0.0;
  432.    RFile_Name := '';
  433.  
  434.    FOR I := 4 DOWNTO 1 DO
  435.       RFile_Size := RFile_Size * 256.0 + Sector_Data[I];
  436.  
  437.    Blocks_To_Get  := ROUND( RFile_Size / 128.0 + 0.49 );
  438.  
  439.    File_Time := Sector_Data[6] SHL 8 OR Sector_Data[5];
  440.    File_Date := Sector_Data[8] SHL 8 OR Sector_Data[7];
  441.  
  442.    FOR I := 9 TO 24 DO
  443.       IF Sector_Data[I] <> 0 THEN
  444.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  445.  
  446.    RFile_Name := TRIM( Rfile_Name );
  447.  
  448.    Draw_Menu_Frame( 15, 10, 78, 23, Menu_Frame_Color,
  449.                     Menu_Text_Color,
  450.                     'Receive file ' + FileName + ' using ' + Tname );
  451.  
  452.    Dir_Convert_Time( File_Time, CTime );
  453.    Dir_Convert_Date( File_Date, CDate );
  454.  
  455.    Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color,
  456.                     Menu_Text_Color, '' );
  457.  
  458.                                    (* Headings for Ymodem information *)
  459.    Window( 16, 4, 77, 8 );
  460.  
  461.    GoToXY( 1 , 1 );
  462.    WRITE(' File name:           ',FileName);
  463.    GoToXY( 1 , 2 );
  464.    WRITE(' File Size in bytes:  ',RFile_Size:8:0);
  465.    GoToXY( 1 , 3 );
  466.    WRITE(' File Size in blocks: ',Blocks_To_Get:8:0);
  467.    GoToXY( 1 , 4 );
  468.    WRITE(' File creation time:  ',CTime );
  469.    GoToXY( 1 , 5 );
  470.    WRITE(' File creation date:  ',CDate );
  471.  
  472.                                    (* Restore previous window *)
  473.    Window( 16, 11, 77, 21 );
  474.  
  475.    IF RFile_Size > 0.0 THEN
  476.       BEGIN
  477.  
  478.          Display_Time   := TRUE;
  479.          Time_To_Send   := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate );
  480.          Time_Per_Block := Time_To_Send / Blocks_To_Get;
  481.  
  482.          Initialize_Receive_Display;
  483.  
  484.          Truncate_File  := TRUE;
  485.  
  486.       END;
  487.                                    (* Prevent clobbers in host mode *)
  488.    IF Host_Mode THEN
  489.       Stop_Receive := Stop_Receive OR
  490.                       Scan_Xfer_List( FileName )   OR
  491.                       ( FileName = 'PIBTERM.USF' ) OR
  492.                       ( FileName = 'PIBTERM.XFR' ) OR
  493.                       ( FileName = 'PIBTERM.MSG' ) OR
  494.                       ( FileName = 'PIBTERM.CMT' ) OR
  495.                       ( FileName = 'PIBTERM.CMT' );
  496.  
  497. END    (* Receive_Telink_Header *);
  498.  
  499. (*----------------------------------------------------------------------*)
  500. (*           Receive_Ymodem_Header --- Get Ymodem block 0 header        *)
  501. (*----------------------------------------------------------------------*)
  502.  
  503. PROCEDURE Receive_Ymodem_Header;
  504.  
  505. (*----------------------------------------------------------------------*)
  506. (*                                                                      *)
  507. (*     Procedure:  Receive_Ymodem_Header                                *)
  508. (*                                                                      *)
  509. (*     Purpose:    Gets Ymodem header block 0 (filename+size+date)      *)
  510. (*                                                                      *)
  511. (*     Calling Sequence:                                                *)
  512. (*                                                                      *)
  513. (*        Receive_Ymodem_Header                                         *)
  514. (*                                                                      *)
  515. (*     Calls:                                                           *)
  516. (*                                                                      *)
  517. (*        Draw_Menu_Frame                                               *)
  518. (*        Dir_Convert_Time                                              *)
  519. (*        Dir_Convert_Date                                              *)
  520. (*        Open_Receiving_File                                           *)
  521. (*                                                                      *)
  522. (*----------------------------------------------------------------------*)
  523.  
  524. VAR
  525.    I     : INTEGER;
  526.    CTime : STRING[10];
  527.    CDate : STRING[10];
  528.    Year  : INTEGER;
  529.    Month : INTEGER;
  530.    Day   : INTEGER;
  531.    Hour  : INTEGER;
  532.    Mins  : INTEGER;
  533.    Secs  : INTEGER;
  534.  
  535. (*----------------------------------------------------------------------*)
  536.  
  537. PROCEDURE Get_Ymodem_Date(     Date  : REAL;
  538.                            VAR Year  : INTEGER;
  539.                            VAR Month : INTEGER;
  540.                            VAR Day   : INTEGER;
  541.                            VAR Hour  : INTEGER;
  542.                            VAR Mins  : INTEGER;
  543.                            VAR Secs  : INTEGER );
  544.  
  545. CONST
  546.    Secs_Per_Year      = 31536000.0;
  547.    Secs_Per_Leap_Year = 31622400.0;
  548.    Secs_Per_Day       = 86400.0;
  549.    Secs_Per_Hour      = 3600.0;
  550.    Secs_Per_Minute    = 60.0;
  551.  
  552. VAR
  553.    RDate     : REAL;
  554.    T         : REAL;
  555.  
  556. (* STRUCTURED *) CONST
  557.    Days_Per_Month : ARRAY[1..12] OF BYTE
  558.                     = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  559.  
  560. BEGIN (* Get_Ymodem_Date *)
  561.  
  562.    Year  := 1970;
  563.    Month := 1;
  564.  
  565.    RDate := Date - GMT_Difference * Secs_Per_Hour;
  566.  
  567.    WHILE( RDate > 0.0 ) DO
  568.       BEGIN
  569.  
  570.          IF ( Year MOD 4 ) = 0 THEN
  571.             T := Secs_Per_Leap_Year
  572.          ELSE
  573.             T := Secs_Per_Year;
  574.  
  575.          RDate := RDate - T;
  576.          Year  := Year  + 1;
  577.  
  578.       END;
  579.  
  580.    RDate := RDate + T;
  581.    Year  := Year  - 1;
  582.  
  583.    IF ( Year MOD 4 ) = 0 THEN
  584.       Days_Per_Month[2] := 29
  585.    ELSE
  586.       Days_Per_Month[2] := 28;
  587.  
  588.    WHILE( RDate > 0.0 ) DO
  589.       BEGIN
  590.  
  591.          T     := Days_Per_Month[Month] * Secs_Per_Day;
  592.  
  593.          RDate := RDate - T;
  594.          Month := Month + 1;
  595.  
  596.       END;
  597.  
  598.    RDate := RDate + T;
  599.    Month := Month - 1;
  600.  
  601.    Day   := TRUNC( INT( ( Rdate + Secs_Per_Day - 1 ) / Secs_Per_Day  ) );
  602.    Rdate := Rdate - ( Day - 1 ) * Secs_Per_Day;
  603.  
  604.    Hour  := TRUNC( INT( Rdate / Secs_Per_Hour ) );
  605.    Rdate := Rdate - Hour * Secs_Per_Hour;
  606.  
  607.    Mins  := TRUNC( INT( Rdate / Secs_Per_Minute ) );
  608.    Secs  := TRUNC( Rdate - Mins * Secs_Per_Minute );
  609.  
  610. END   (* Get_Ymodem_Date *);
  611.  
  612. (*----------------------------------------------------------------------*)
  613.  
  614. BEGIN  (* Receive_Ymodem_Header *)
  615.  
  616.    RFile_Size := 0.0;
  617.    RFile_Date := 0.0;
  618.    RFile_Name := '';
  619.    File_Time  := 0;
  620.    File_Date  := 0;
  621.                                    (* Pick up file name *)
  622.    I := 1;
  623.    WHILE( Sector_Data[I] <> NUL ) DO
  624.       BEGIN
  625.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  626.          I          := I + 1;
  627.       END;
  628.                                   (* If null file name, this means *)
  629.                                   (* end of Ymodem batch, so quit. *)
  630.    IF LENGTH( RFile_Name ) = 0 THEN
  631.       BEGIN
  632.          Null_File_Name := TRUE;
  633.          EXIT;
  634.       END;
  635.                                   (* Pick up file size *)
  636.    I := I + 1;
  637.  
  638.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  639.       BEGIN
  640.          RFile_Size := RFile_Size * 10.0 + ORD( Sector_Data[I] ) - ORD('0');
  641.          I          := I + 1;
  642.       END;
  643.  
  644.    I := I + 1;
  645.  
  646.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  647.       BEGIN
  648.          RFile_Date := RFile_Date * 8.0 + ORD( Sector_Data[I] ) - ORD('0');
  649.          I          := I + 1;
  650.       END;
  651.  
  652.    IF RFile_Date > 0 THEN
  653.       BEGIN
  654.  
  655.          Get_Ymodem_Date( RFile_Date, Year, Month, Day, Hour, Mins, Secs );
  656.  
  657.          File_Time := Hour SHL 11 OR Mins SHL 5 OR ( Secs DIV 2 );
  658.          File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day;
  659.  
  660.          Dir_Convert_Time( File_Time, CTime );
  661.          Dir_Convert_Date( File_Date, CDate );
  662.  
  663.       END;
  664.  
  665.    Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color,
  666.                     Menu_Text_Color,
  667.                     'Receive file ' + RFile_Name + ' using ' + Tname );
  668.  
  669.                                    (* Headings for Ymodem information *)
  670.    Window( 16, 4, 77, 8 );
  671.  
  672.    GoToXY( 1 , 1 );
  673.    WRITE(' File name:              ',RFile_Name);
  674.  
  675.    Blocks_To_Get  := ROUND( RFile_Size / 1024.0 + 0.49 );
  676.  
  677.    IF RFile_Size > 0.0 THEN
  678.       BEGIN
  679.          GoToXY( 1 , 2 );
  680.          WRITE(' File Size in bytes:     ',RFile_Size:8:0);
  681.          GoToXY( 1 , 3 );
  682.          WRITE(' File Size in 1K blocks: ',Blocks_To_Get:8:0);
  683.       END;
  684.  
  685.    Blocks_To_Get  := ROUND( RFile_Size / 128.0 + 0.49 );
  686.  
  687.    IF File_Date > 0 THEN
  688.       BEGIN
  689.          GoToXY( 1 , 4 );
  690.          WRITE(' File creation time:     ',CTime );
  691.          GoToXY( 1 , 5 );
  692.          WRITE(' File creation date:     ',CDate );
  693.       END;
  694.  
  695.    FileName := RFile_Name;
  696.                                    (* Restore previous window *)
  697.    Window( 16, 11, 77, 21 );
  698.  
  699.    IF Rfile_Size > 0.0 THEN
  700.       BEGIN
  701.  
  702.          Display_Time   := TRUE;
  703.          Time_To_Send   := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate );
  704.          Time_Per_Block := Time_To_Send / Blocks_To_Get;
  705.  
  706.          Initialize_Receive_Display;
  707.  
  708.          Truncate_File  := ( RFile_Size > 0.0 );
  709.  
  710.       END;
  711.                                    (* Prevent clobbers in host mode *)
  712.    IF Host_Mode THEN
  713.       Stop_Receive := Stop_Receive OR
  714.                       Scan_Xfer_List( FileName )   OR
  715.                       ( FileName = 'PIBTERM.USF' ) OR
  716.                       ( FileName = 'PIBTERM.XFR' ) OR
  717.                       ( FileName = 'PIBTERM.MSG' ) OR
  718.                       ( FileName = 'PIBTERM.CMT' ) OR
  719.                       ( FileName = 'PIBTERM.CMT' );
  720.  
  721.                                    (* Open reception file     *)
  722.    IF ( NOT Stop_Receive ) THEN
  723.       Open_Receiving_File;
  724.  
  725. END    (* Receive_Ymodem_Header *);
  726.  
  727. (*----------------------------------------------------------------------*)
  728. (*        Wait_For_SOH --- Wait for start for start of XMODEM block     *)
  729. (*----------------------------------------------------------------------*)
  730.  
  731. PROCEDURE Wait_For_SOH(     Wait_Time    : INTEGER;
  732.                         VAR Initial_Ch   : INTEGER;
  733.                         VAR Stop_Receive : BOOLEAN  );
  734.  
  735. (*----------------------------------------------------------------------*)
  736. (*                                                                      *)
  737. (*     Procedure:  Wait_For_SOH                                         *)
  738. (*                                                                      *)
  739. (*     Purpose:    Waits for SOH/STX/SYN initiating Xmodem block        *)
  740. (*                                                                      *)
  741. (*     Calling Sequence:                                                *)
  742. (*                                                                      *)
  743. (*        Wait_For_SOH(     Wait_Time    : INTEGER;                     *)
  744. (*                      VAR Initial_Ch   : INTEGER;                     *)
  745. (*                      VAR Stop_Receive : BOOLEAN );                   *)
  746. (*                                                                      *)
  747. (*           Wait_Time    --- time to wait for character in seconds     *)
  748. (*           Initial_Ch   --- returned initial character                *)
  749. (*           Stop_Receive --- TRUE if Alt-R hit to stop transfer        *)
  750. (*                                                                      *)
  751. (*     Calls:                                                           *)
  752. (*                                                                      *)
  753. (*        Async_Receive_With_Timeout                                    *)
  754. (*                                                                      *)
  755. (*----------------------------------------------------------------------*)
  756.  
  757. VAR
  758.    Kbd_Ch: CHAR;
  759.    ITime : INTEGER;
  760.  
  761. BEGIN  (* Wait_For_SOH *)
  762.                                    (* If already cancelled transfer, *)
  763.                                    (* don't look for more input!     *)
  764.    Initial_Ch := TimeOut;
  765.  
  766.    IF Stop_Receive THEN EXIT;
  767.  
  768.                                    (* Look for start of Xmodem block *)
  769.    ITime := 0;
  770.  
  771.    REPEAT
  772.  
  773.       ITime := ITime + 1;
  774.  
  775.       Async_Receive_With_Timeout( One_Second, Initial_Ch );
  776.  
  777.                                    (* Check for keyboard input -- Alt_R *)
  778.                                    (* cancels transfer.                 *)
  779.       IF KeyPressed THEN
  780.          BEGIN
  781.             READ( Kbd, Kbd_Ch );
  782.             IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN
  783.                BEGIN
  784.                    READ( Kbd, Kbd_Ch );
  785.                    Alt_R_Pressed := ( ORD( Kbd_Ch ) = Alt_R );
  786.                    Stop_Receive  := Stop_Receive OR Alt_R_Pressed;
  787.                END;
  788.          END;
  789.                                    (* Also stop transfer if carrier drops *)
  790.  
  791.       IF Async_Carrier_Drop THEN
  792.          BEGIN
  793.             Stop_Receive := TRUE;
  794.             Initial_Ch   := TimeOut;
  795.          END;
  796.  
  797.    UNTIL ( Stop_Receive          OR
  798.            ( ITime > Wait_Time ) OR
  799.            ( Initial_Ch <> TimeOut ) );
  800.  
  801. END    (* Wait_For_SOH *);
  802.  
  803. (*----------------------------------------------------------------------*)
  804. (*       Set_File_Date_And_Time --- set file date and time stamp        *)
  805. (*----------------------------------------------------------------------*)
  806.  
  807. PROCEDURE Set_File_Date_And_Time;
  808.  
  809. VAR
  810.    OLd_Time   : INTEGER;
  811.    Old_Date   : INTEGER;
  812.    Err        : INTEGER;
  813.    File_Handle: INTEGER;
  814.  
  815. (*----------------------------------------------------------------------*)
  816.  
  817. PROCEDURE Set_File_Time_Error;
  818.  
  819. BEGIN (* Set_File_Time_Error *)
  820.  
  821.    GoToXY( 25 , 10 );
  822.    WRITE('Could not set date/time for file.');
  823.    ClrEol;
  824.  
  825.    DELAY( One_Second_Delay );
  826.  
  827. END   (* Set_File_Time_Error *);
  828.  
  829. (*----------------------------------------------------------------------*)
  830.  
  831. BEGIN (* Set_File_Date_And_Time *)
  832.  
  833.    Err  := Open_File_Handle( FileName, Access_Read_And_Write_Mode,
  834.                              File_Handle );
  835.  
  836.    IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  837.       Set_File_Time_Error
  838.    ELSE
  839.       BEGIN
  840.  
  841.          Err  := Dir_Set_File_Date_And_Time( File_Handle, File_Date,
  842.                                              File_Time );
  843.  
  844.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  845.             Set_File_Time_Error
  846.          ELSE
  847.             BEGIN
  848.  
  849.                Err  := Close_File_Handle( File_Handle );
  850.  
  851.                IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  852.                   Set_File_Time_Error;
  853.  
  854.             END;
  855.  
  856.       END;
  857.  
  858. END   (* Set_File_Date_And_Time *);
  859.  
  860. (*----------------------------------------------------------------------*)
  861. (*             Write_File_Data --- Write received data to file          *)
  862. (*----------------------------------------------------------------------*)
  863.  
  864. PROCEDURE Write_File_Data;
  865.  
  866. PROCEDURE Do_Actual_Write( Write_Count: INTEGER );
  867.  
  868. BEGIN (* Do_Actual_Write *)
  869.  
  870.    IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND Truncate_File THEN
  871.       Write_Count := TRUNC( RFile_Size - Rfile_Size_2 );
  872.  
  873.    Err := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count );
  874.  
  875.    IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  876.       BEGIN
  877.          GoToXY( 25 , 10 );
  878.          WRITE('Error in writing to disk, transfer cancelled.');
  879.          ClrEol;
  880.          DELAY( One_Second_Delay );
  881.          Stop_Receive := TRUE;
  882.       END;
  883.  
  884.    RFile_Size_2 := RFile_Size_2 + Write_Count;
  885.  
  886. END   (* Do_Actual_Write *);
  887.  
  888. (*----------------------------------------------------------------------*)
  889.  
  890. BEGIN (* Write_File_Data *)
  891.                                    (* Write directly from sector *)
  892.                                    (* if not long buffer used    *)
  893.    IF ( NOT Long_Buffer ) THEN
  894.       Do_Actual_Write( Sector_Length )
  895.  
  896.                                    (* Store sector data in long  *)
  897.                                    (* buffer and write file if   *)
  898.                                    (* necessary.                 *)
  899.  
  900.    ELSE
  901.       BEGIN
  902.  
  903.          IF ( Buffer_Pos + Sector_Length ) > Buffer_Length THEN
  904.             BEGIN
  905.                Do_Actual_Write( Buffer_Pos );
  906.                Buffer_Pos   := 0;
  907.             END;
  908.  
  909.          MOVE( Sector_Data, Write_Buffer^[ Buffer_Pos + 1 ], Sector_Length );
  910.  
  911.          Buffer_Pos := Buffer_Pos + Sector_Length;
  912.  
  913.       END;
  914.  
  915. END   (* Write_File_Data *);
  916.  
  917. (*----------------------------------------------------------------------*)
  918. (*             Cancel_Transfer --- Cancel transfer                      *)
  919. (*----------------------------------------------------------------------*)
  920.  
  921. PROCEDURE Cancel_Transfer;
  922.  
  923. BEGIN (* Cancel_Transfer *)
  924.  
  925.                                    (* Purge reception *)
  926.    Async_Purge_Buffer;
  927.                                    (* Send five cancels, then five *)
  928.                                    (* backspaces.                  *)
  929.  
  930.    Async_Send( CHR( CAN ) );
  931.    Async_Send( CHR( CAN ) );
  932.    Async_Send( CHR( CAN ) );
  933.    Async_Send( CHR( CAN ) );
  934.    Async_Send( CHR( CAN ) );
  935.  
  936.    Async_Send( CHR( BS  ) );
  937.    Async_Send( CHR( BS  ) );
  938.    Async_Send( CHR( BS  ) );
  939.    Async_Send( CHR( BS  ) );
  940.    Async_Send( CHR( BS  ) );
  941.  
  942. END   (* Cancel_Transfer *);
  943.  
  944. (*----------------------------------------------------------------------*)
  945.  
  946. BEGIN  (* Receive_Xmodem_File *)
  947.                                    (* Open display window for transfer  *)
  948.    Save_Screen( Saved_Screen );
  949.  
  950.    CASE Transfer_Protocol OF
  951.       Xmodem_Chk   : Tname := 'Xmodem (Checksum)';
  952.       Xmodem_Crc   : Tname := 'Xmodem (CRC)';
  953.       Telink       : Tname := 'Telink';
  954.       Modem7_Chk   : Tname := 'Modem7 (Checksum)';
  955.       Modem7_CRC   : Tname := 'Modem7 (CRC)';
  956.       Ymodem       : Tname := 'Ymodem';
  957.       Ymodem_Batch : Tname := 'Ymodem Batch';
  958.    END (* CASE *);
  959.  
  960.    IF FileName = '' THEN
  961.       Menu_Title := 'Receive file using ' + Tname
  962.    ELSE
  963.       Menu_Title := 'Receive file ' + FileName + ' using ' + Tname;
  964.  
  965.    Draw_Menu_Frame( 15, 10, 78, 22, Menu_Frame_Color,
  966.                     Menu_Text_Color, Menu_Title );
  967.  
  968.    Window( 16, 11, 77, 21 );
  969.                                    (* Initialize status display information *)
  970.    SOH_Errors     := 0;
  971.    BlockL_Errors  := 0;
  972.    BlockN_Errors  := 0;
  973.    Comple_Errors  := 0;
  974.    Timeout_Errors := 0;
  975.    Resend_Errors  := 0;
  976.    CRC_Errors     := 0;
  977.    Display_Time   := FALSE;
  978.  
  979.    Initialize_Receive_Display;
  980.                                    (* Current sector = 0 *)
  981.    Sector_Number  := 0;
  982.    Sector_Count   := 0;
  983.    Sector_Prev    := 0;
  984.    Sector_Length  := 128;
  985.                                    (* Overall error count = 0 *)
  986.    Error_Count    := 0;
  987.                                    (* CRC tries *)
  988.    CRC_Tries      := 0;
  989.                                    (* How long to wait for SOH *)
  990.    SOH_Time       := Ten_Seconds;
  991.                                    (* Assume file size not sent *)
  992.    Truncate_File  := FALSE;
  993.                                    (* Assume file size, date not sent *)
  994.    RFile_Size     := 0.0;
  995.    RFile_Size_2   := 0.0;
  996.    RFile_Date     := 0.0;
  997.    File_Date      := 0;
  998.    File_Time      := 0;
  999.                                    (* Assume file name not sent *)
  1000.    RFile_Name     := '';
  1001.                                    (* Assume transfer fails *)
  1002.    OK_Transfer    := FALSE;
  1003.                                    (* Assume block 0 not found *)
  1004.    Block_Zero     := FALSE;
  1005.                                    (* Starting time  *)
  1006.    Start_Time     := TimeOfDay;
  1007.                                    (* User intervention flag *)
  1008.    Alt_R_Pressed  := FALSE;
  1009.                                    (* Serious error flag     *)
  1010.    Stop_Receive   := FALSE;
  1011.                                    (* Not null file name   *)
  1012.    Null_File_Name := FALSE;
  1013.                                    (* Allocate buffer if requested   *)
  1014.                                    (* otherwise use sector data area *)
  1015.                                    (* directly.                      *)
  1016.    IF Max_Write_Buffer > 1024 THEN
  1017.       BEGIN
  1018.          Buffer_Length  := Max_Write_Buffer;
  1019.          Long_Buffer    := TRUE;
  1020.          GetMem( Write_Buffer , Buffer_Length );
  1021.       END
  1022.    ELSE
  1023.       BEGIN
  1024.          Long_Buffer  := FALSE;
  1025.          Write_Buffer := ADDR( Sector_Data );
  1026.       END;
  1027.                                    (* Empty write buffer   *)
  1028.    Buffer_Pos     := 0;
  1029.                                    (* Open reception file now if possible *)
  1030.    RFile_Open     := FALSE;
  1031.  
  1032.    IF FileName <> '' THEN
  1033.       BEGIN
  1034.          Open_Receiving_File;
  1035.          IF Stop_Receive THEN
  1036.             BEGIN
  1037.                Cancel_Transfer;
  1038.                DELAY( Two_Second_Delay );
  1039.                Restore_Screen( Saved_Screen );
  1040.                Reset_Global_Colors;
  1041.                EXIT;
  1042.             END;
  1043.       END;
  1044.  
  1045.                                    (* Begin XMODEM loop    *)
  1046.    REPEAT
  1047.                                    (* Reset error flag *)
  1048.       Error_flag := FALSE;
  1049.                                    (* Look for SOH     *)
  1050.       REPEAT
  1051.  
  1052.          IF Sector_Count = 0 THEN
  1053.             BEGIN
  1054.  
  1055.                Use_CRC := Use_CRC AND ( CRC_Tries < 4 );
  1056.  
  1057.                                    (* Purge reception      *)
  1058.                Async_Purge_Buffer;
  1059.                                    (* Indicate XMODEM type *)
  1060.                IF Use_Crc THEN
  1061.                   Async_Send( 'C' )
  1062.                ELSE
  1063.                   Async_Send( CHR( NAK ) );
  1064.  
  1065.                CRC_Tries := CRC_Tries + 1;
  1066.  
  1067.                GoToXY( 1 , 8 );
  1068.  
  1069.                IF ( NOT Use_Crc ) THEN
  1070.                   WRITELN(' Checksum errors      :')
  1071.                ELSE
  1072.                   WRITELN(' CRC errors           :');
  1073.  
  1074.             END;
  1075.  
  1076.          Wait_For_SOH( SOH_Time, Initial_Ch , Stop_Receive );
  1077.  
  1078.                                    (* If CAN found, insist on    *)
  1079.                                    (* at least two CANs in a row *)
  1080.                                    (* before cancelling transfer *)
  1081.  
  1082.          IF Initial_Ch = CAN THEN
  1083.             Wait_For_SOH( SOH_Time, Initial_Ch , Stop_Receive );
  1084.  
  1085.       UNTIL ( Initial_Ch = SOH         ) OR
  1086.             ( Initial_Ch = EOT         ) OR
  1087.             ( Initial_Ch = CAN         ) OR
  1088.             ( Initial_Ch = SYN         ) OR
  1089.             ( Initial_Ch = STX         ) OR
  1090.             ( Initial_Ch = TimeOut     ) OR
  1091.             ( Error_Count > Max_Errors ) OR
  1092.             ( Stop_Receive             );
  1093.  
  1094.                                    (* Something wrong already -- *)
  1095.                                    (* cancel the transfer.       *)
  1096.       IF Stop_Receive THEN
  1097.          BEGIN
  1098.             IF NOT Async_Carrier_Detect THEN
  1099.                BEGIN
  1100.                   Display_Receive_Error('Carrier dropped.');
  1101.                   DELAY( Two_Second_Delay );
  1102.                END;
  1103.          END
  1104.                                    (* Timed out -- no SOH found *)
  1105.  
  1106.       ELSE IF Initial_Ch = Timeout THEN
  1107.          BEGIN
  1108.             Display_Receive_Error( 'Time out error, no SOH');
  1109.             Timeout_Errors := Timeout_Errors + 1;
  1110.          END
  1111.                                    (* SYN found -- Telink header         *)
  1112.                                    (* SOH found -- start of XMODEM block *)
  1113.                                    (* STX found -- start of Ymodem block *)
  1114.  
  1115.       ELSE IF ( Initial_Ch = SOH ) OR
  1116.               ( Initial_Ch = SYN ) OR
  1117.               ( Initial_Ch = STX ) THEN
  1118.          BEGIN (* SOH found *)
  1119.                                    (* Pick up sector number *)
  1120.  
  1121.             IF Initial_Ch = STX THEN
  1122.                Sector_Length := 1024
  1123.             ELSE
  1124.                Sector_Length := 128;
  1125.  
  1126.             Async_Receive_With_Timeout( One_Second , Ch );
  1127.  
  1128.             IF Ch = TimeOut THEN
  1129.                BEGIN
  1130.                   BlockL_Errors := BlockL_Errors + 1;
  1131.                   Display_Receive_Error('Short block');
  1132.                END;
  1133.  
  1134.             Sector_Number := Ch;
  1135.  
  1136.                                    (* Complement of sector number *)
  1137.  
  1138.             Async_Receive_With_Timeout( One_Second , Ch );
  1139.  
  1140.             IF Ch = TimeOut THEN
  1141.                BEGIN
  1142.                   BlockL_Errors := BlockL_Errors + 1;
  1143.                   Display_Receive_Error('Short block');
  1144.                END;
  1145.  
  1146.             Sector_Comp := Ch;
  1147.                                    (* See if they add up properly     *)
  1148.  
  1149.             IF ( ( Sector_Number + Sector_Comp ) = 255 ) THEN
  1150.  
  1151.                BEGIN  (* Sector number and complement match *)
  1152.  
  1153.                   Sector_Prev1 := Sector_Prev + 1;
  1154.  
  1155.                   Block_Zero   := ( Sector_Count  = 0 ) AND
  1156.                                   ( Sector_Number = 0 ) AND
  1157.                                   ( ( Initial_Ch  = SYN ) OR
  1158.                                     ( Transfer_Protocol IN [Ymodem,
  1159.                                                             Ymodem_Batch] ) );
  1160.  
  1161.                   IF ( Sector_Number = Sector_Prev1 ) OR Block_Zero THEN
  1162.                      BEGIN  (* Correct sector found *)
  1163.  
  1164.                         Use_CRC_2 := Use_CRC AND
  1165.                                      ( NOT ( Block_Zero AND
  1166.                                              ( Transfer_Protocol = Telink ) ) );
  1167.  
  1168.                         IF Receive_Xmodem_Sector( Use_CRC_2 ) THEN
  1169.                            IF ( NOT Block_Zero ) THEN
  1170.                               BEGIN (* Checksum/CRC OK *)
  1171.  
  1172.                                  Write_File_Data;
  1173.  
  1174.                                  Error_Count  := 0;
  1175.  
  1176.                                  Sector_Count := Sector_Count + 1;
  1177.  
  1178.                                  Sector_Prev := Sector_Number;
  1179.  
  1180.                                  Async_Send( CHR( ACK ) );
  1181.  
  1182.                               END   (* Checksum/CRC OK *)
  1183.                            ELSE (* Telink/Ymodem block 0 *)
  1184.                               BEGIN
  1185.  
  1186.                                  IF ( Initial_Ch = SYN ) THEN
  1187.                                     Receive_Telink_Header
  1188.                                  ELSE IF ( Transfer_Protocol IN [Ymodem,
  1189.                                                           Ymodem_Batch] ) THEN
  1190.                                     Receive_Ymodem_Header;
  1191.  
  1192.                                  IF ( NOT Stop_Receive ) THEN
  1193.                                     BEGIN
  1194.                                        Async_Send( CHR( ACK ) );
  1195.                                        Error_Count := 0;
  1196.                                     END;
  1197.  
  1198.                               END
  1199.                         ELSE
  1200.                            BEGIN  (* Checksum/CRC error *)
  1201.                               CRC_Errors := CRC_Errors + 1;
  1202.                               IF Use_Crc THEN
  1203.                                  Display_Receive_Error('CRC error')
  1204.                               ELSE
  1205.                                  Display_Receive_Error('Checksum error');
  1206.                            END    (* Checksum/CRC error *)
  1207.  
  1208.                      END  (* Correct sector found *)
  1209.  
  1210.                   ELSE
  1211.                      IF ( Sector_Number = Sector_Prev ) THEN
  1212.                         BEGIN  (* Duplicate sector *)
  1213.  
  1214.                            Display_Receive_Error('Duplicate block ');
  1215.  
  1216.                            Resend_Errors := Resend_Errors + 1;
  1217.  
  1218.                            Async_Send( CHR( ACK ) );
  1219.  
  1220.                         END   (* Duplicate sector *)
  1221.                   ELSE
  1222.                      BEGIN
  1223.                         Display_Receive_Error('Synchronization error');
  1224.                         BlockN_Errors := BlockN_Errors + 1;
  1225.                      END;
  1226.  
  1227.                END   (* Sector # and complement match *)
  1228.  
  1229.             ELSE
  1230.                BEGIN (* Sector # and complement do not match *)
  1231.                   Display_Receive_Error('Sector number error');
  1232.                   Comple_Errors := Comple_Errors + 1;
  1233.                END   (* Sector # and complement do not match *);
  1234.  
  1235.          END (* SOH Found *)
  1236.       ELSE IF ( Initial_Ch <> EOT ) THEN
  1237.          BEGIN
  1238.             Display_Receive_Error('SOH not found');
  1239.             SOH_Errors := SOH_Errors + 1;
  1240.          END;
  1241.  
  1242.       IF Error_Flag THEN
  1243.          BEGIN
  1244.             Error_Count := Error_Count + 1;
  1245.             Async_Purge_Buffer;
  1246.             Async_Send( CHR( NAK ) );
  1247.          END;
  1248.  
  1249.       IF Display_Time THEN
  1250.          BEGIN
  1251.  
  1252.             IF ( NOT Error_Flag ) THEN
  1253.                Time_To_Send := Time_To_Send -
  1254.                                Time_Per_Block * ( Sector_Length / 128 );
  1255.  
  1256.             IF Time_To_Send < 0.0 THEN
  1257.                Time_To_Send := 0.0;
  1258.  
  1259.          END;
  1260.  
  1261.       Update_Xmodem_Receive_Display;
  1262.  
  1263.    UNTIL ( Initial_Ch = EOT     ) OR
  1264.          ( Initial_Ch = CAN     ) OR
  1265.          ( Stop_Receive         ) OR
  1266.          ( Null_File_Name       ) OR
  1267.          ( Error_Count > Max_Errors );
  1268.  
  1269.                                    (* If serious error or Alt_R hit, *)
  1270.                                    (* stop download.                 *)
  1271.    IF ( Stop_Receive ) THEN
  1272.       BEGIN
  1273.  
  1274.          Cancel_Transfer;
  1275.  
  1276.          IF Alt_R_Pressed THEN
  1277.             BEGIN
  1278.                GoToXY( 25 , 10 );
  1279.                WRITE('Alt-R key hit -- reception cancelled.');
  1280.                Writelne('ALT-R key hit, reception cancelled.', FALSE);
  1281.                ClrEol;
  1282.             END;
  1283.  
  1284.       END
  1285.                                    (* Null file name -- end of batch *)
  1286.    ELSE IF Null_File_Name THEN
  1287.       BEGIN
  1288.          GoToXY( 25 , 10 );
  1289.          WRITE('Null file name received.');
  1290.          Writelne('Null file name received.', FALSE);
  1291.          ClrEol;
  1292.       END
  1293.                                    (* EOT received, error count OK *)
  1294.  
  1295.    ELSE IF ( Initial_Ch = EOT ) AND ( Error_Count <= Max_Errors ) THEN
  1296.       BEGIN
  1297.                                    (* Acknowledge EOT  *)
  1298.          Async_Send( CHR( ACK ) );
  1299.  
  1300.                                    (* Write any remaining data in buffer *)
  1301.          IF Buffer_Pos > 0 THEN
  1302.             BEGIN
  1303.  
  1304.                Write_Count := Buffer_Pos;
  1305.  
  1306.                IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND
  1307.                    Truncate_File THEN
  1308.                       Write_Count := TRUNC( RFile_Size - Rfile_Size_2 );
  1309.  
  1310.                Err := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count );
  1311.  
  1312.                IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  1313.                   BEGIN
  1314.                      GoToXY( 25 , 10 );
  1315.                      WRITE('Error in writing to disk, file may be bad.');
  1316.                      ClrEol;
  1317.                      DELAY( One_Second_Delay );
  1318.                   END;
  1319.  
  1320.                RFile_Size_2 := RFile_Size_2 + Write_Count;
  1321.  
  1322.             END;
  1323.  
  1324.          GoToXY( 2 , 10 );
  1325.          WRITE('Transfer complete; ');
  1326.  
  1327.          End_Time       := TimeOfDay;
  1328.  
  1329.          IF RFile_Size > 0.0 THEN
  1330.             IF RFile_Size <= RFile_Size_2 THEN
  1331.                RFile_Size_2 := RFile_Size;
  1332.  
  1333.          IF End_Time > Start_Time THEN
  1334.             BEGIN
  1335.  
  1336.                Effective_Rate := RFile_Size_2 / ( End_Time - Start_Time );
  1337.  
  1338.                WRITE('transfer rate was ',Effective_Rate:6:1,' CPS');
  1339.                ClrEol;
  1340.  
  1341.                OK_Transfer := TRUE;
  1342.  
  1343.             END;
  1344.  
  1345.          Writelne('Received file ' + FileName , FALSE );
  1346.  
  1347.       END
  1348.    ELSE IF ( Initial_Ch = CAN ) THEN
  1349.       BEGIN
  1350.          GoToXY( 25 , 10 );
  1351.          WRITE('Transmitter cancelled file transfer.');
  1352.          Writelne('Transmitter cancelled file transfer.', FALSE);
  1353.          ClrEol;
  1354.       END
  1355.    ELSE
  1356.       BEGIN
  1357.          GoToXY( 25 , 10 );
  1358.          WRITE('Transfer Cancelled');
  1359.          Writelne('Transfer cancelled', FALSE);
  1360.          ClrEol;
  1361.       END;
  1362.                                    (* Close transferred file *)
  1363.  
  1364.    Err := Close_File_Handle( XFile_Handle );
  1365.    I   := Int24Result;
  1366.                                    (* Set file time and date if Telink *)
  1367.                                    (* or Ymodem                        *)
  1368.  
  1369.    IF ( File_Date > 0 ) AND Use_Time_Sent THEN
  1370.       Set_File_Date_And_Time;
  1371.  
  1372.    DELAY( Two_Second_Delay );
  1373.                                    (* Remove download buffer           *)
  1374.  
  1375.    IF Long_Buffer THEN
  1376.       FREEMEM( Write_Buffer , Buffer_Length );
  1377.  
  1378.                                    (* Remove XMODEM window             *)
  1379.    Restore_Screen( Saved_Screen );
  1380.  
  1381.    Reset_Global_Colors;
  1382.  
  1383. END    (* Receive_Xmodem_File *) ;
  1384.